home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1999 January / PC Plus Super CD No55a (PCP-147A-1-99) (Disc 1) (1998).iso / linux / developers / visualtcl / windows / vtcl / lib / tops.tcl < prev    next >
Encoding:
Text File  |  1997-09-14  |  6.6 KB  |  204 lines
  1. ##############################################################################
  2. # $Id: tops.tcl,v 1.10 1997/09/14 21:08:30 stewart Exp $
  3. #
  4. # tops.tcl - procedures for managing toplevel windows
  5. #
  6. # Copyright (C) 1996-1997 Stewart Allen
  7. #
  8. # This program is free software; you can redistribute it and/or
  9. # modify it under the terms of the GNU General Public License
  10. # as published by the Free Software Foundation; either version 2
  11. # of the License, or (at your option) any later version.
  12. #
  13. # This program is distributed in the hope that it will be useful,
  14. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. # GNU General Public License for more details.
  17. #
  18. # You should have received a copy of the GNU General Public License
  19. # along with this program; if not, write to the Free Software
  20. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. ##############################################################################
  23. #
  24.  
  25. proc vTcl:wm_take_focus {target} {
  26.     global vTcl
  27.     if {$vTcl(w,class) == "Toplevel"} {
  28.         set vTcl(w,insert) $target
  29.     }
  30.     vTcl:place_handles $vTcl(w,widget)
  31. }
  32.  
  33. proc vTcl:destroy_top {target} {
  34.     global vTcl
  35.     if [winfo exists $target] {
  36.         if {[vTcl:get_class $target] == "Toplevel"} {
  37.             destroy $target
  38.         }
  39.     }
  40.     if {[info procs vTclWindow$target] != ""} {
  41.         rename vTclWindow$target {}
  42.     }
  43.     if {[info procs vTclWindow(pre)$target] != ""} {
  44.         rename vTclWindow$target {}
  45.     }
  46.     if {[info procs vTclWindow(post)$target] != ""} {
  47.         rename vTclWindow$target {}
  48.     }
  49.     set x [lsearch $vTcl(tops) $target]
  50.     if {$x >= 0} {
  51.         set vTcl(tops) [lreplace $vTcl(tops) $x $x]
  52.     }
  53. }
  54.  
  55. proc vTcl:show_top {target} {
  56.     global vTcl
  57.     if [winfo exists $target] {
  58.         if {[vTcl:get_class $target] == "Toplevel"} {
  59.             wm deiconify $target
  60.             raise $target
  61.         }
  62.     } else {
  63.         Window show $target
  64.         wm deiconify $target
  65.         raise $target
  66.         vTcl:setup_bind_tree $target
  67.         vTcl:update_top_list
  68.     }
  69. }
  70.  
  71. proc vTcl:hide_top {target} {
  72.     global vTcl
  73.     if [winfo exists $target] {
  74.         if {[vTcl:get_class $target] == "Toplevel"} {
  75.             wm withdraw $target
  76.         }
  77.     }
  78. }
  79.  
  80. proc vTcl:update_top_list {} {
  81.     global vTcl
  82.     if [winfo exists .vTcl.toplist] {
  83.         .vTcl.toplist.f2.list delete 0 end
  84.         set index 0
  85.         foreach i $vTcl(tops) {
  86.             if [catch {set n [wm title $i]}] {
  87.                 set n $i
  88.             }
  89.             .vTcl.toplist.f2.list insert end $n
  90.             set vTcl(tops,$index) $i
  91.             incr index
  92.         }
  93.     }
  94. }
  95.  
  96. proc vTcl:toplist:show {{on ""}} {
  97.     global vTcl
  98.     if {$on == "flip"} { set on [expr - $vTcl(pr,show_top)] }
  99.     if {$on == ""}     { set on $vTcl(pr,show_top) }
  100.     if {$on == 1} {
  101.         Window show $vTcl(gui,toplist)
  102.         vTcl:update_top_list
  103.     } else {
  104.         Window hide $vTcl(gui,toplist)
  105.     }
  106.     set vTcl(pr,show_top) $on
  107. }
  108.  
  109. proc vTclWindow.vTcl.toplist {args} {
  110.     global vTcl
  111.     set base .vTcl.toplist
  112.     if {[winfo exists .vTcl.toplist]} {
  113.         wm deiconify .vTcl.toplist; return
  114.     }
  115.     toplevel .vTcl.toplist -class vTcl
  116.     wm transient .vTcl.toplist .vTcl
  117.     wm focusmodel .vTcl.toplist passive
  118.     wm geometry .vTcl.toplist 200x200+714+382
  119.     wm maxsize .vTcl.toplist 1137 870
  120.     wm minsize .vTcl.toplist 200 100
  121.     wm overrideredirect .vTcl.toplist 0
  122.     wm resizable .vTcl.toplist 1 1
  123.     wm deiconify .vTcl.toplist
  124.     wm title .vTcl.toplist "Window List"
  125.     wm protocol $base WM_DELETE_WINDOW {vTcl:toplist:show 0}
  126.     bind .vTcl.toplist <Double-Button-1> {
  127.         set vTcl(x) [.vTcl.toplist.f2.list curselection]
  128.         if {$vTcl(x) != ""} {
  129.             vTcl:show_top $vTcl(tops,$vTcl(x))
  130.         }
  131.     }
  132.     frame .vTcl.toplist.frame7 \
  133.         -borderwidth 1 -height 30 -relief sunken -width 30 
  134.     pack .vTcl.toplist.frame7 \
  135.         -in .vTcl.toplist -anchor center -expand 0 -fill x -ipadx 0 -ipady 0 \
  136.         -padx 0 -pady 0 -side bottom 
  137.     button .vTcl.toplist.frame7.button8 \
  138.         -command {
  139.             set vTcl(x) [.vTcl.toplist.f2.list curselection]
  140.             if {$vTcl(x) != ""} {
  141.                 vTcl:show_top $vTcl(tops,$vTcl(x))
  142.             }
  143.         } \
  144.          -padx 9 \
  145.         -pady 3 -text Show -width 4 
  146.     pack .vTcl.toplist.frame7.button8 \
  147.         -in .vTcl.toplist.frame7 -anchor center -expand 1 -fill x -ipadx 0 \
  148.         -ipady 0 -padx 0 -pady 0 -side left 
  149.     button .vTcl.toplist.frame7.button9 \
  150.         -command {
  151.             set vTcl(x) [.vTcl.toplist.f2.list curselection]
  152.             if {$vTcl(x) != ""} {
  153.                 vTcl:hide_top $vTcl(tops,$vTcl(x))
  154.             }
  155.         } \
  156.          -padx 9 \
  157.         -pady 3 -text Hide -width 4 
  158.     pack .vTcl.toplist.frame7.button9 \
  159.         -in .vTcl.toplist.frame7 -anchor center -expand 1 -fill x -ipadx 0 \
  160.         -ipady 0 -padx 0 -pady 0 -side left 
  161.     button .vTcl.toplist.frame7.button10 \
  162.         -command {
  163.             set vTcl(x) [.vTcl.toplist.f2.list curselection]
  164.             if {$vTcl(x) != ""} {
  165.                 vTcl:destroy_top $vTcl(tops,$vTcl(x))
  166.                 .vTcl.toplist.f2.list delete $vTcl(x)
  167.             }
  168.         } \
  169.          -padx 9 \
  170.         -pady 3 -text Delete -width 4
  171.     pack .vTcl.toplist.frame7.button10 \
  172.         -in .vTcl.toplist.frame7 -anchor center -expand 1 -fill x -ipadx 0 \
  173.         -ipady 0 -padx 0 -pady 0 -side left 
  174.     button .vTcl.toplist.frame7.button11 \
  175.         -command { vTcl:toplist:show 0 } \
  176.          -padx 9 \
  177.         -pady 3 -text Done -width 4 
  178.     pack .vTcl.toplist.frame7.button11 \
  179.         -in .vTcl.toplist.frame7 -anchor center -expand 1 -fill x -ipadx 0 \
  180.         -ipady 0 -padx 0 -pady 0 -side left 
  181.     frame .vTcl.toplist.f2 \
  182.         -borderwidth 1 -height 30 -relief sunken -width 30 
  183.     pack .vTcl.toplist.f2 \
  184.         -in .vTcl.toplist -anchor center -expand 1 -fill both -ipadx 0 \
  185.         -ipady 0 -padx 0 -pady 0 -side top 
  186.     listbox .vTcl.toplist.f2.list \
  187.         -yscrollcommand {.vTcl.toplist.f2.sb4 set} -exportselection 0
  188.     pack .vTcl.toplist.f2.list \
  189.         -in .vTcl.toplist.f2 -anchor center -expand 1 -fill both -ipadx 0 \
  190.         -ipady 0 -padx 0 -pady 0 -side left 
  191.     scrollbar .vTcl.toplist.f2.sb4 \
  192.         -command {.vTcl.toplist.f2.list yview}
  193.     pack .vTcl.toplist.f2.sb4 \
  194.         -in .vTcl.toplist.f2 -anchor center -expand 0 -fill y -ipadx 0 \
  195.         -ipady 0 -padx 0 -pady 0 -side right 
  196.  
  197.     wm withdraw .vTcl.toplist
  198.     vTcl:setup_vTcl:bind .vTcl.toplist
  199.     catch {wm geometry .vTcl.toplist $vTcl(geometry,.vTcl.toplist)}
  200.     update idletasks
  201.     wm deiconify .vTcl.toplist
  202. }
  203.  
  204.